home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / DATADICT / IMPORTDD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-07  |  7.6 KB  |  158 lines
  1. unit Importdd;
  2. interface
  3. uses DB, DBCtrls, DBTables;
  4. function AddToDict(var DictDB : tdatabase; var DictTable : ttable; var DictQuery : tQuery; var DictDataSource : tDatasource;
  5.                    var FromDB : tdatabase; var FromTable : ttable; var FromQuery : Tquery; var FromDataSource : tDatasource;
  6.                    const DictPath, DictTablename, FromPath, FromTablename : string): boolean;
  7.  
  8.  
  9. implementation
  10. uses sysutils, dialogs, forms, controls, dbutils;
  11. function AddToDict(var DictDB : tdatabase; var DictTable : ttable; var DictQuery : tQuery; var DictDataSource : tDatasource;
  12.                    var FromDB : tdatabase; var FromTable : ttable; var FromQuery : Tquery; var FromDataSource : tDatasource;
  13.                    const DictPath, DictTablename, FromPath, FromTablename : string): boolean;
  14. var
  15.   tmpint, thisfield : integer;
  16.   tmpstr : string;
  17.   FromField : tField;
  18. begin
  19.   try
  20.     if openDB(DictDb, DictTable, DictQuery, DictDataSource,
  21.               DictPath, DictTablename)
  22.        and
  23.        OpenDB(FromDB, FromTable, FromQuery, FromDataSource,
  24.               FromPath, FromTablename)
  25.       then begin with DictTable do begin
  26.         for thisfield := 0 to fromTable.fieldCount -1 do begin
  27.           append;
  28.           findfield('Table_name').text := FromTablename;
  29.           case FromTable.tabletype of
  30.             ttDefault : tmpstr := 'ttDefault';
  31.             ttdBase   : tmpstr := 'ttDbase';
  32.             ttParadox : tmpstr := 'ttParadox';
  33.             ttASCII   : tmpstr := 'ttASCII';
  34.             end;
  35.           findField('Table_type').text := tmpstr;
  36.           findField('Field_name').text := FromTable.fields[thisfield].fieldname;
  37.           findField('Field_type').text := FieldTypeStr[FromTable.fields[thisfield].datatype];
  38.           FromField := FromTable.fields[thisfield];
  39.           tStringField(findField('Tag')).value := IntToSTr(FromField.tag);
  40.           tStringField(findField('Scr_prompt')).value := FromField.DisplayName^;
  41.           tStringField(findField('Scr_fmt')).Value := FromField.EditMask;
  42.           tStringField(findField('EditMask')).Value := FromField.EditMask;
  43.             {DisplayText grabs the data in the first record for this field...}
  44.           tStringField(FindField('Grd_prompt')).Value := FromField.DisplayLabel;
  45.           tintegerField(FindField('Grd_width')).Value := FromField.DisplayWidth;
  46.           tIntegerField(FindField('Tab_order')).value := FromField.index;
  47.           tbooleanField(FindField('Field_idx')).value := FromField.isIndexField;
  48.           tbooleanField(FindField('Required')).value := Fromfield.Required;
  49.           case fromTable.fields[thisfield].datatype of
  50.             ftUnknown  :   tmpint := 0;
  51.             ftString  :    tmpint := fromField.size;
  52.             ftSmallint,
  53.             ftInteger,
  54.             ftWord,
  55.             ftBoolean,
  56.             ftFloat,
  57.             ftCurrency  :   tmpint := 0;
  58.             ftBCD       :   tmpint := fromField.size;
  59.             ftDate,
  60.             ftTime,
  61.             ftDateTime  :   tmpint := 0;
  62.             ftBytes,
  63.             ftVarBytes,
  64.             ftBlob,
  65.             ftMemo,
  66.             ftGraphic    : tmpint := fromField.size;
  67.             end;
  68.           tIntegerField(FindField('Field_len')).value := tmpint;
  69.           case fromTable.fields[thisfield].datatype of
  70.             ftUnknown  : begin
  71.                            messagedlg('Unkown field type!',mtinformation, [mbOK], 0);
  72.                            end;
  73.             fTString   : begin
  74.                            tIntegerField(FindField('Field_len')).value := FromField.size;
  75.                            {TDBEDIT, memo:  set isMasked true if Editmask nonblank;
  76.                             set maxLength to field_len}
  77.                            end;
  78.             fTSmallint,
  79.             ftInteger,
  80.             ftword      : begin
  81.                             if TIntegerField(FromField).editFormat <> ''
  82.                               then tStringField(findField('EditMask')).Value := TIntegerField(FromField).EditFormat
  83.                               else tStringField(findField('EditMask')).Value := TIntegerField(FromField).EditMask;
  84.                             tStringField(findField('Scr_fmt')).Value := TIntegerField(FromField).DisplayFormat;
  85.                             tIntegerField(FindField('Field_len')).value := TIntegerField(FromField).size;
  86.                             tIntegerField(FindField('minval')).value := TIntegerField(FromField).minvalue;
  87.                             tIntegerField(FindField('maxval')).value := TIntegerField(FromField).maxvalue;
  88.                            end;
  89.             ftFloat,
  90.             ftCurrency,
  91.             ftBCD        : begin
  92.                              tIntegerField(findField('Field_dec')).value := TFloatField(FromField).precision;
  93.                             if TFloatField(FromField).editFormat <> ''
  94.                               then tStringField(findField('EditMask')).Value := TFloatField(FromField).EditFormat
  95.                               else tStringField(findField('EditMask')).Value := TFloatField(FromField).EditMask;
  96.                             tStringField(findField('Scr_fmt')).Value := TFloatField(FromField).DisplayFormat;
  97.                             tIntegerField(FindField('Field_len')).value := TFloatField(FromField).size;
  98.                             {these are double values!
  99.                             tIntegerField(FindField('minval')).value := FromField.minvalue;
  100.                             tIntegerField(FindField('maxval')).value := TFloatField(FromField).maxvalue;
  101.                             }
  102.                             end;
  103.             end;
  104.           post;
  105.           end;  {for thisfield to fieldcount}
  106.         end;    {with DictTable}
  107.         result := true;
  108.         end  {if was able to open both databases}
  109.      else begin
  110.        {could not open both databases...}
  111.        result := false;
  112.        exit;
  113.        end;
  114.   except     { some error occured after tables open}
  115.      on EdataBaseError do begin
  116.        screen.cursor := crDefault;
  117.        MessageDlg('DB error while reading field info...', mtInformation, [mbOK], 0);
  118.        result := false;
  119.        end;
  120.      end; {of exceptions}
  121. end;
  122.  
  123. {
  124. ftUnknown
  125. TStringField    Fixed length text data up to 255 characters
  126. TSmallintField  Whole numbers in the range -32768 to 32767
  127. TIntegerField   Whole numbers in the range -2,147,483,648 to 2,147,483,647
  128. TWordField      Whole numbers in the range 0 to 65535
  129. TBooleanField   True or False values
  130. TFloatField     Real numbers with absolute magnitudes from 5.0*10-324 to 1.7*10308
  131.                 accurate to 15-16 digits
  132. TCurrencyField  Currency values. The range and accuracy is the same as TFloatField
  133. TBCDField       Real numbers with a fixed number of digits after the decimal point.
  134.                 Accurate to 18 digits. Range depends on the number of digits after the
  135.                  decimal point. [Paradox only]
  136. TDateField      Date value
  137. TTimeField      Time value
  138. TDateTimeField  Date and time value
  139. TBytesField     Arbitrary data field without a size limit
  140. TVarBytesField  Arbitrary data field up to 65535 characters, with the actual length stored
  141.                 in the first two bytes
  142. TBlobField      Arbitrary data field without a size limit
  143. TMemoField      Arbitrary length text
  144. TGraphicField   Arbitrary length graphic, such as a bitmap
  145. }
  146. (**
  147. property Value: string;      {TStringField}
  148. property Value: Longint;     {TIntegerField, TSmallintField,
  149. TWordField}
  150. property Value: Double;      {TBCDField, TCurrencyField,
  151. TFloatField}
  152. property Value: Boolean;     {TBooleanField}
  153. property Value: TDateTime    {TDateField, TDateTimeField,
  154. TTimeField}
  155. **)
  156.  
  157. end.
  158.